home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / EGAVGA.SWG / 0004_Mode-13 Variable Width font.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  5.3 KB  |  154 lines
  1. Program SaruFont;
  2. { Mail suggestions & Improvements to eddy.jansson@saru.ct.se }
  3. Uses Dos,Crt;
  4.  
  5. var
  6.  F              :File;
  7.  BytesRead      :Word;
  8.  Font           :Array[1..8192] of Byte; { Better safe than sorry ;}
  9.  
  10. Const
  11. (*
  12. font: db 5,32,58 { Fontheight,first defined character, characters defined }
  13.       db width,bitmapline1,bitmapline2..bitmapline[height]
  14.       etc..
  15. *)
  16.  SmallFont :Array[1..357] of byte = (5, 32, 58, { Space to 'Z' }
  17.   2,  0,  0,  0,  0,  0,  2, 64, 64, 64,  0, 64,  3,144,144,  0,
  18.   0,  0,  3,144,248,144,248,144,  3, 96,128, 64, 32,192,  3,  0,144, 32, 64,
  19. 144,  3, 64,160, 64,  0,224,  3, 64,128,  0,  0,  0,  3, 32, 64, 64, 64, 32,
  20.   3, 64, 32, 32, 32, 64,  3,144, 96, 96,144,  0,  3, 32, 32,248, 32, 32,  2,
  21.   0,  0,  0, 64,128,  3,  0,  0,240,  0,  0,  2,  0,  0,  0,  0, 64,  3,  8,
  22.  16, 32, 64,128,  3, 64,160,160,160, 64,  3, 64,192, 64, 64,224,  3,224, 32,
  23.  64,128,224,  3,224, 32,224, 32,224,  3,160,160,224, 32, 32,  3,224,128,224,
  24.  32,224,  3,224,128,224,160,224,  3,224, 32, 32, 32, 32,  3, 64,160, 64,160,
  25.  64,  3,224,160,224, 32, 32,  3,  0, 96,  0,  0, 96,  3,  0, 96,  0,  0, 96,
  26.   3, 64,128,  0,128, 64,  3,  0,240,  0,240,  0,  3, 32, 16,  8, 16, 32,  3,
  27. 192, 32, 64,  0, 64,  3,240,  8,104, 72,  8,  3,224,160,224,160,160,  3,192,
  28. 160,192,160,192,  3,224,128,128,128,224,  3,192,160,160,160,192,  3,224,128,
  29. 192,128,224,  3,224,128,192,128,128,  3,224,128,160,160,224,  3,160,160,224,
  30. 160,160,  3,224, 64, 64, 64,224,  3,224, 32, 32, 32,224,  3,160,160,192,160,
  31. 160,  3,128,128,128,128,224,  3,160,224,160,160,160,  3,160,224,224,160,160,
  32.   3, 64,160,160,160, 64,  3,192,160,192,128,128,  3, 64,160,160,224, 96,  3,
  33. 192,160,192,192,160,  3, 96,128, 64, 32,192,  3,192, 32, 32, 32, 32,  3,160,
  34. 160,160,160,224,  3,160,160,160,160, 64,  5,136,168,168,168, 80,  3,160,160,
  35.  64,160,160,  3,160,160, 64, 64, 64,  3,224, 32, 64,128,224);
  36.  
  37. Procedure SRMUserFont(const Font: Pointer;const X,Y: Word;
  38.                       const Color: Byte;const S: String); Assembler;
  39. { Write to a 320*200*256 screen using a variable width font.
  40.   Please note that this is my first ever asm-routine, and
  41.   because of that you'll have to use nullterminated pascalstrings,
  42.   _OR_ you could just hack the code.. :-)  // Eddy.Jansson@saru.ct.se }
  43. var
  44.  FirstChar,
  45.  CharHeight   :Byte;
  46.  CharNr,
  47.  ScreenPTR    :Word;
  48.  
  49. asm
  50.  push ds
  51.  
  52.  mov ax,0a000h     { Setup ES:[BX] = X,Y to plot at }
  53.  mov es,ax
  54.  mov bx,x
  55.  mov ax,y
  56.  xchg ah,al
  57.  add bx,ax
  58.  shr ax,2
  59.  add bx,ax
  60.  
  61. (* Use this instead if you have a Lookuptable:
  62.  mov bx,y          { Setup ES:[BX] = X,Y to plot at }
  63.  add bx,bx
  64.  mov ax,$a000      { easily modified to point to a virtual screen }
  65.  mov es,ax         { Lookup tables rules :-) }
  66.  mov bx,word ptr YTable[bx]
  67.  add bx,x          { Voila! bx = offset onto screen }
  68. *)
  69.  
  70.  lds di,font
  71.  mov dl,[di]       { height of font goes into dh }
  72.  mov CharHeight,dl
  73.  inc di
  74.  mov dl,[di]
  75.  mov FirstChar,dl
  76.  mov CharNr,0     { Ugh! Character counter, not a very }
  77.                   { good method, but I'm all out of registers :-( }
  78.  
  79. @nextchar:
  80.  inc CharNr       { also skips lengthbyte! }
  81.  push ds          { This I don't like, pushing and popping. }
  82.  lds si,[S]       { But unfortunately I can't seem to find }
  83.  add si,CharNr    { any spare registers? Intel, can you help? }
  84.  lodsb            { load asciivalue into al }
  85.  pop ds
  86.  cmp al,0         { check for null-termination }
  87.  je @exit         { exit if end of string }
  88.  
  89.  mov ScreenPTR,BX { save bx }
  90.  mov dh,CharHeight
  91.  xor ah,ah
  92.  mov cl,firstchar { firstchar }
  93.  sub al,cl        { al = currentchar - firstchar }
  94.  mov si,ax        { di = scrap register }
  95.  mul dh           { ax * fontheight }
  96.  add ax,si        { ax + characters to skip }
  97.  
  98.  lds di,font      { This can be omptimized I think (preserve DI) }
  99.  add di,3         { skip header }
  100.  add di,ax        { Point into structure }
  101.  mov cl,[di]      { get character width }
  102.  
  103. @nextline:
  104.  mov ch,cl        { ch is the height counter. cl is the original. }
  105.  inc di           { .. now points to bitmap }
  106.  mov dl,[di]      { get bitmap byte }
  107.  
  108. @nextpixel:
  109.  rol dl,1         { rotate bitmap and prepare for next pixel }
  110.  mov al,dl        { mov bitmap into al for manipulation }
  111.  and al,1         { mask out the correct bit }
  112.  jz @masked       { jump if transperent }
  113.  mov al,color
  114.  mov byte ptr es:[bx],al { Set the pixel on the screen }
  115. @masked:
  116.  inc bx           { increment X-offset }
  117.  dec ch           { are we done? last byte in character? }
  118.  jnz @nextpixel   { nope, out with another pixel }
  119.  add bx,320       { Go to next line on the screen }
  120.  sub bx,cx        { X-alignment fixup }
  121.  dec dh           { are we done with the character? }
  122.  jnz @nextline
  123.  mov bx,ScreenPTR { restore screen offset and prepare for next character }
  124.  add bx,cx
  125.  inc bx           { A little gap between the letters, thank you... }
  126.  jmp @nextchar
  127.  
  128. @exit:
  129.  pop ds
  130. end;
  131.  
  132. BEGIN
  133.  asm
  134.   mov ax,$13
  135.   int $10
  136.  end;
  137.  
  138. {
  139.  Assign(F,'C:\TEMP\SMALLER.BIN');
  140.  Reset(F,1);
  141.  BlockRead(F,Font,FileSize(F),BytesRead);
  142.  Close(F);
  143. }
  144.  
  145.  
  146.  { This example font gives you about 80*32 characters/screen }
  147.  
  148. for BytesRead:=0 to 32 do
  149.  SRMUserFont(@SmallFont,0,BytesRead*6,64-BytesRead,
  150. '12345678901234567890123456789012345678901234567890123456789012345678901234567890'+#0);
  151.  ReadLn;
  152.  
  153. END.
  154.